Zaawansowana eksploracja danych projekt 1
Wojciech Szczepaniak
2022-02-26
1 Wstęp
Zbiory danych zawierały bardzo dużo atrybutów dotyczących krajów,
gospodarek, walut i cen. Zebrane zostały na przestrzeni wielu lat i
przestawiały interesujące dane. Dzięki analizie udało ustalić, że wiele
atrybutów znacząco koreluje z cenami złota jak i cenami bitcoina. Na ich
podstawie można stworzyć model regresji, który z dużą skutecznością jest
w stanie przewidzieć ceny złota.
Ostatecznie regresor został wytrenowany na podstawie poniższych
danych:
S&P:
- Divident
- Earnings
- CPI
- Real.Divident
Światowy wskaźnik rozwoju:
-GDP (current US dollar)
Wytrenowany model dla zbioru testowego przyjął następujące wartości
miar:
- RMSE = 26.35187
- MAE = 13.19214
Najważniejszymi atrybutami dla trenowanego modelu okazało się: CPI -
model RandomForest
GDP - model RandomForest z dobranymi parametrami
2 Biblioteki
Wykorzystane biblioteki:
library(readxl)
library(corrplot)
library(caret)
library(dplyr)
library(tidyr)
library(plotly)
library(ggplot2)
library(tidyverse)
library(ggpubr)
library(patchwork)
library(hrbrthemes)
library(DT)
library(gganimate)
library(gifski)
library(randomForest)
library(Metrics)3 Zapewnienie powtarzalności
Zapewnienie powtarzalności wyników w projekcie uzyskano dzięki ustawieniu ziarna generatora liczb losowych.
set.seed(42)4 Wczytywanie danych
W przypadku bitcoina wykorzystany zostanie zbiór danych zawierających jego cenę w danym dniu wyrażoną w dolarach.
INDI <- read_xlsx("Data pack/World_Development_Indicators.xlsx", na = '..')
RATES <- read.csv("Data pack/CurrencyExchangeRates.csv")
GOLD <- read.csv("Data pack/Gold prices.csv")
COMP <- read.csv("Data Pack/S&P Composite.csv")
MKPRU <- read.csv("Data pack/Bitcoin/BCHAIN-MKPRU.csv")5 Podsumowanie danych
5.1 Światowy wskaźnik rozwoju - INDI
Spośród wielu krajów wybrać można kraje posiadające największe PKB kolejno: Stany Zjednoczone, Chiny, Japonia, Niemcy oraz Wielka Brytania czy kraje posiadających najwięcej rezerw złota w tonach: Stany zjednoczone, Niemcy Włochy, Francja oraz Rosja. Kraje te powinny wywierać największy wpływ na ceny surowców dostępnych na całym świecie. Ostatecznie wybrane zostały statystyki dla całego świata, dzięki czemu naraz ujęte w analizie zostaną zarówno największe mocarstwa, jak i te drobniejsze kraje.
INDI <- INDI %>%
filter(`Country Name` %in% c("World"))Można zauważyć, że zebrane dane w wielu latach posiadają dużą ilość brakujących wartości. Uzupełnianie brakujących wartości nie byłoby proste i mogłoby spowodować zakłamanie wyników, dlatego po przekształceniu zbioru zostały usunięte rekordy w których występowały wartości puste.
INDI <- INDI %>%
select(-c("Country Name","Country Code")) %>%
gather("Year", "Value", -c("Series Name", "Series Code")) %>%
mutate(Year = substr(Year, 1, 4), `Series Name` = gsub("\\$", " dollar", `Series Name`)) Zbiór danych dodatkowo został przekształcony, aby ułatwić pracę nad nim i uzyskać przejrzystość danych.
INDI <- INDI %>%
drop_na()
summary(INDI)## Series Name Series Code Year Value
## Length:5738 Length:5738 Length:5738 Min. :-1.686e+11
## Class :character Class :character Class :character 1st Qu.: 1.300e+01
## Mode :character Mode :character Mode :character Median : 4.100e+01
## Mean : 1.294e+12
## 3rd Qu.: 4.935e+06
## Max. : 1.012e+145.2 Kursy walut - RATES
W przypadku kursów wymiany walut dane zbierane były od 1995 do 2018 roku. Można zauważyć, że prawie wszystkie z podanych walut mają wartości puste a wiele z nich nawet powyżej 4000 pustych pomiarów. Może to wynikać z dynamiki geopolitycznej krajów. Na świecie na przestrzeni lat wiele walut było wprowadzonych do obiegu, jak i z niego wyprowadzanych. Możliwe też, że po prostu zbiór danych nie jest pełny. Ze względu na dużą ilość wartości pustych uzupełnianie ich o wartości bazujące na poprzedzających/następujących wartościach mogłoby spowodować zakłamanie badanych wartości. Natomiast usunięcie wartości pustych powoduje, że zostają tylko lata 2010 do 2018 i to niepełne. Dlatego ten zbiór danych nie będzie wykorzystany w późniejszych badaniach.
RATES$Date <- as.Date(RATES$Date)
summary(RATES)## Date Algerian.Dinar Australian.Dollar Bahrain.Dinar
## Min. :1995-01-02 Min. : 71.29 Min. :0.4833 Min. :0.376
## 1st Qu.:2000-10-05 1st Qu.: 77.50 1st Qu.:0.6654 1st Qu.:0.376
## Median :2006-07-06 Median : 81.28 Median :0.7595 Median :0.376
## Mean :2006-07-27 Mean : 90.59 Mean :0.7683 Mean :0.376
## 3rd Qu.:2012-05-07 3rd Qu.:108.88 3rd Qu.:0.8689 3rd Qu.:0.376
## Max. :2018-05-02 Max. :115.58 Max. :1.1055 Max. :0.376
## NA's :4112 NA's :263 NA's :69
## Bolivar.Fuerte Botswana.Pula Brazilian.Real Brunei.Dollar
## Min. : 2.14 Min. :0.0855 Min. :0.832 Min. :1.000
## 1st Qu.: 2.59 1st Qu.:0.1197 1st Qu.:1.709 1st Qu.:1.348
## Median : 6.28 Median :0.1528 Median :2.048 Median :1.468
## Mean : 835.09 Mean :0.1965 Mean :2.161 Mean :1.508
## 3rd Qu.: 6.28 3rd Qu.:0.1844 3rd Qu.:2.794 3rd Qu.:1.698
## Max. :68827.50 Max. :4.8414 Max. :4.195 Max. :1.851
## NA's :3664 NA's :1275 NA's :539 NA's :1246
## Canadian.Dollar Chilean.Peso Chinese.Yuan Colombian.Peso
## Min. :0.917 Min. :377.5 Min. :6.093 Min. : 833.2
## 1st Qu.:1.086 1st Qu.:503.5 1st Qu.:6.495 1st Qu.:1786.0
## Median :1.297 Median :538.6 Median :6.989 Median :2017.6
## Mean :1.268 Mean :561.8 Mean :7.316 Mean :2073.1
## 3rd Qu.:1.409 3rd Qu.:619.8 3rd Qu.:8.277 3rd Qu.:2482.9
## Max. :1.613 Max. :758.2 Max. :8.746 Max. :3434.9
## NA's :356 NA's :1220 NA's :1316 NA's :582
## Czech.Koruna Danish.Krone Euro Hungarian.Forint
## Min. :14.45 Min. :4.665 Min. :0.8252 Min. :144.1
## 1st Qu.:19.35 1st Qu.:5.612 1st Qu.:1.0889 1st Qu.:202.7
## Median :21.88 Median :6.051 Median :1.2295 Median :224.3
## Mean :22.95 Mean :6.281 Mean :1.2076 Mean :231.1
## 3rd Qu.:24.94 3rd Qu.:6.805 3rd Qu.:1.3338 3rd Qu.:267.6
## Max. :40.29 Max. :9.006 Max. :1.5990 Max. :318.7
## NA's :1850 NA's :251 NA's :1070 NA's :1415
## Icelandic.Krona Indian.Rupee Indonesian.Rupiah Iranian.Rial
## Min. : 54.72 Min. :31.37 Min. : 2201 Min. : 1699
## 1st Qu.: 70.28 1st Qu.:42.82 1st Qu.: 8855 1st Qu.: 1755
## Median : 83.48 Median :45.92 Median : 9260 Median : 8992
## Mean : 92.46 Mean :48.02 Mean : 9144 Mean :10718
## 3rd Qu.:117.15 3rd Qu.:52.33 3rd Qu.:11380 3rd Qu.:11180
## Max. :147.98 Max. :68.78 Max. :14850 Max. :42000
## NA's :354 NA's :429 NA's :1492 NA's :1312
## Israeli.New.Sheqel Japanese.Yen Kazakhstani.Tenge Korean.Won
## Min. :3.230 Min. : 75.86 Min. :117.2 Min. : 756
## 1st Qu.:3.676 1st Qu.:100.70 1st Qu.:145.4 1st Qu.:1013
## Median :3.882 Median :109.39 Median :150.3 Median :1122
## Mean :4.003 Mean :107.97 Mean :185.6 Mean :1100
## 3rd Qu.:4.370 3rd Qu.:118.38 3rd Qu.:185.7 3rd Qu.:1186
## Max. :4.994 Max. :147.00 Max. :383.9 Max. :1965
## NA's :1939 NA's :316 NA's :3051 NA's :601
## Kuwaiti.Dinar Libyan.Dinar Malaysian.Ringgit Mauritian.Rupee
## Min. :0.2646 Min. :0.525 Min. :2.436 Min. :25.15
## 1st Qu.:0.2854 1st Qu.:0.662 1st Qu.:3.188 1st Qu.:29.12
## Median :0.2947 Median :1.932 Median :3.676 Median :30.67
## Mean :0.2936 Mean :1.510 Mean :3.508 Mean :31.03
## 3rd Qu.:0.3027 3rd Qu.:1.932 3rd Qu.:3.800 3rd Qu.:32.89
## Max. :0.3089 Max. :1.932 Max. :4.725 Max. :36.50
## NA's :1054 NA's :123 NA's :301 NA's :2460
## Mexican.Peso Nepalese.Rupee New.Zealand.Dollar Norwegian.Krone
## Min. : 5.915 Min. : 49.88 Min. :0.3927 Min. :4.959
## 1st Qu.:10.953 1st Qu.: 68.33 1st Qu.:0.5813 1st Qu.:6.104
## Median :12.680 Median : 74.04 Median :0.6844 Median :6.709
## Mean :13.116 Mean : 77.37 Mean :0.6606 Mean :6.965
## 3rd Qu.:13.668 3rd Qu.: 86.80 3rd Qu.:0.7364 3rd Qu.:7.806
## Max. :21.908 Max. :109.98 Max. :0.8822 Max. :9.606
## NA's :2266 NA's :479 NA's :310 NA's :291
## Nuevo.Sol Pakistani.Rupee Peso.Uruguayo Philippine.Peso
## Min. :2.539 Min. : 30.88 Min. : 9.32 Min. :24.55
## 1st Qu.:2.755 1st Qu.: 51.79 1st Qu.:20.07 1st Qu.:43.18
## Median :2.819 Median : 60.75 Median :22.94 Median :44.40
## Mean :2.960 Mean : 70.24 Mean :24.11 Mean :45.01
## 3rd Qu.:3.243 3rd Qu.: 94.29 3rd Qu.:28.44 3rd Qu.:47.10
## Max. :3.522 Max. :115.70 Max. :32.53 Max. :52.35
## NA's :4297 NA's :488 NA's :4287 NA's :4198
## Polish.Zloty Qatar.Riyal Rial.Omani Russian.Ruble
## Min. :2.022 Min. :3.64 Min. :0.3845 Min. :23.13
## 1st Qu.:3.033 1st Qu.:3.64 1st Qu.:0.3845 1st Qu.:28.27
## Median :3.290 Median :3.64 Median :0.3845 Median :30.54
## Mean :3.365 Mean :3.64 Mean :0.3845 Mean :36.91
## 3rd Qu.:3.822 3rd Qu.:3.64 3rd Qu.:0.3845 3rd Qu.:36.20
## Max. :4.500 Max. :3.64 Max. :0.3845 Max. :83.59
## NA's :1765 NA's :47 NA's :56 NA's :2435
## Saudi.Arabian.Riyal Singapore.Dollar South.African.Rand Sri.Lanka.Rupee
## Min. :3.745 Min. :1.201 Min. : 3.530 Min. : 49.57
## 1st Qu.:3.745 1st Qu.:1.361 1st Qu.: 6.213 1st Qu.: 77.54
## Median :3.750 Median :1.444 Median : 7.480 Median :103.99
## Mean :3.749 Mean :1.503 Mean : 8.113 Mean :102.19
## 3rd Qu.:3.750 3rd Qu.:1.687 3rd Qu.: 9.995 3rd Qu.:126.29
## Max. :3.750 Max. :1.851 Max. :16.771 Max. :157.65
## NA's :46 NA's :259 NA's :535 NA's :509
## Swedish.Krona Swiss.Franc Thai.Baht Trinidad.And.Tobago.Dollar
## Min. : 5.843 Min. :0.7253 Min. :24.44 Min. :5.839
## 1st Qu.: 6.838 1st Qu.:0.9777 1st Qu.:31.50 1st Qu.:6.260
## Median : 7.618 Median :1.1878 Median :34.65 Median :6.282
## Mean : 7.741 Mean :1.2090 Mean :35.14 Mean :6.310
## 3rd Qu.: 8.384 3rd Qu.:1.3903 3rd Qu.:39.45 3rd Qu.:6.382
## Max. :10.995 Max. :1.8228 Max. :56.06 Max. :6.789
## NA's :349 NA's :239 NA's :565 NA's :657
## Tunisian.Dinar U.A.E..Dirham U.K..Pound.Sterling U.S..Dollar
## Min. :1.342 Min. :3.671 Min. :1.213 Min. :1
## 1st Qu.:1.566 1st Qu.:3.672 1st Qu.:1.519 1st Qu.:1
## Median :1.723 Median :3.672 Median :1.599 Median :1
## Mean :1.850 Mean :3.672 Mean :1.615 Mean :1
## 3rd Qu.:2.157 3rd Qu.:3.672 3rd Qu.:1.676 3rd Qu.:1
## Max. :2.509 Max. :3.675 Max. :2.102 Max. :1
## NA's :4258 NA's :71 NA's :122count(RATES)## n
## 1 5978RATES <- RATES %>%
drop_na()
count(RATES)## n
## 1 4065.3 Ceny złota - GOLD
Pomiary cen złota były robione codziennie od 1968 roku do 2021 dla 3 walut w godzinach porannych i popołudniowych. Najmniejszą ilość danych pustych możemy zauważyć dla dolara mierzonego w godzinach porannych, dlatego do dalszej analizy użyjemy tej kolumny. Każda z tych walut odzwierciedla kurs złota. W ten sam sposób jedynie różnią się one kursem walutowym między sobą, dlatego wybranie jednej z nich będzie najlepsze. Dodatkowo w przypadku euro jest dużo danych pustych ze względu na to, że waluta ta powstała dopiero w 1999. Wartość pusta została uzupełniona na podstawie dnia poprzedniego lub jeśli on byłby pusty następnego.
summary(GOLD)## Date USD..AM. USD..PM. GBP..AM.
## Length:13585 Min. : 34.77 Min. : 34.75 Min. : 14.48
## Class :character 1st Qu.: 280.50 1st Qu.: 281.50 1st Qu.: 177.71
## Mode :character Median : 383.32 Median : 383.50 Median : 234.51
## Mean : 575.20 Mean : 576.62 Mean : 370.84
## 3rd Qu.: 841.94 3rd Qu.: 851.50 3rd Qu.: 454.32
## Max. :2061.50 Max. :2067.15 Max. :1574.37
## NA's :1 NA's :143 NA's :11
## GBP..PM. EURO..AM. EURO..PM.
## Min. : 14.48 Min. : 237.3 Min. : 236.7
## 1st Qu.: 178.23 1st Qu.: 335.3 1st Qu.: 335.2
## Median : 234.96 Median : 892.6 Median : 896.1
## Mean : 371.81 Mean : 797.3 Mean : 797.2
## 3rd Qu.: 456.43 3rd Qu.:1114.1 3rd Qu.:1114.9
## Max. :1569.59 Max. :1743.8 Max. :1743.4
## NA's :154 NA's :7837 NA's :7880GOLD$Date <- as.Date(GOLD$Date,format="%Y-%m-%d")
GOLD <- select(GOLD, c('Date', 'USD..AM.'))
names(GOLD)[2] <- 'USD'
GOLD <- GOLD %>% fill(names(.),.direction="downup")
summary(GOLD)## Date USD
## Min. :1968-01-02 Min. : 34.77
## 1st Qu.:1981-06-10 1st Qu.: 280.50
## Median :1994-11-14 Median : 383.30
## Mean :1994-11-16 Mean : 575.17
## 3rd Qu.:2008-04-23 3rd Qu.: 841.75
## Max. :2021-09-29 Max. :2061.50gg <- ggplot(data=GOLD, aes(x=Date,y=USD)) + geom_line()
ggplotly(gg)5.4 Indeks giełdowy S&P - COMP
W przypadku S&P Composite można zauważyć, że wartości nie było wiele i zostały one uzupełnione na podstawie poprzedniego miesiąca lub jeśli on byłby pusty to następnego. Pomiary były robione raz w miesiącu od 1871 roku z częstotliwością co miesiąc. Do późniejszej analizy zostały wybrane pomiary pochodzące od 1998 roku w górę, gdyż od tego roku pomiary zbierane były dla wartości złota.
summary(COMP)## Year S.P.Composite Dividend Earnings
## Length:1810 Min. : 2.730 Min. : 0.1800 Min. : 0.1600
## Class :character 1st Qu.: 7.902 1st Qu.: 0.4202 1st Qu.: 0.5608
## Mode :character Median : 17.370 Median : 0.8717 Median : 1.4625
## Mean : 327.968 Mean : 6.7321 Mean : 15.3714
## 3rd Qu.: 164.400 3rd Qu.: 7.0525 3rd Qu.: 14.7258
## Max. :4493.280 Max. :59.6800 Max. :158.7400
## NA's :4 NA's :4
## CPI Long.Interest.Rate Real.Price Real.Dividend
## Min. : 6.28 Min. : 0.620 Min. : 73.9 Min. : 5.445
## 1st Qu.: 10.20 1st Qu.: 3.171 1st Qu.: 186.6 1st Qu.: 9.417
## Median : 20.35 Median : 3.815 Median : 283.3 Median :14.411
## Mean : 62.39 Mean : 4.504 Mean : 622.0 Mean :17.498
## 3rd Qu.:102.28 3rd Qu.: 5.139 3rd Qu.: 707.0 3rd Qu.:22.301
## Max. :273.98 Max. :15.320 Max. :4477.2 Max. :63.511
## NA's :4
## Real.Earnings Cyclically.Adjusted.PE.Ratio
## Min. : 4.576 Min. : 4.784
## 1st Qu.: 14.063 1st Qu.:11.898
## Median : 23.524 Median :16.381
## Mean : 34.907 Mean :17.215
## 3rd Qu.: 43.768 3rd Qu.:20.913
## Max. :159.504 Max. :44.198
## NA's :4 NA's :120COMP$Year <- as.Date(COMP$Year)
COMP <- COMP %>% filter(COMP$Year >=as.Date("1968-01-01")) %>% fill(names(.),.direction="downup")
summary(COMP)## Year S.P.Composite Dividend Earnings
## Min. :1968-01-31 Min. : 67.07 Min. : 2.930 Min. : 5.13
## 1st Qu.:1981-07-07 1st Qu.: 122.53 1st Qu.: 6.401 1st Qu.: 13.83
## Median :1994-12-15 Median : 469.27 Median :13.133 Median : 24.69
## Mean :1994-12-15 Mean : 888.30 Mean :17.872 Mean : 41.76
## 3rd Qu.:2008-05-23 3rd Qu.:1318.06 3rd Qu.:24.003 3rd Qu.: 67.47
## Max. :2021-10-31 Max. :4493.28 Max. :59.680 Max. :158.74
## CPI Long.Interest.Rate Real.Price Real.Dividend
## Min. : 34.10 Min. : 0.620 Min. : 306.3 Min. :18.02
## 1st Qu.: 90.85 1st Qu.: 3.757 1st Qu.: 598.0 1st Qu.:20.36
## Median :149.70 Median : 6.110 Median : 872.2 Median :24.16
## Mean :147.31 Mean : 6.140 Mean :1289.3 Mean :28.62
## 3rd Qu.:212.07 3rd Qu.: 7.893 3rd Qu.:1772.0 3rd Qu.:31.02
## Max. :273.98 Max. :15.320 Max. :4477.2 Max. :63.51
## Real.Earnings Cyclically.Adjusted.PE.Ratio
## Min. : 8.805 Min. : 6.639
## 1st Qu.: 41.947 1st Qu.:13.920
## Median : 50.181 Median :20.499
## Mean : 65.438 Mean :20.775
## 3rd Qu.: 89.861 3rd Qu.:26.386
## Max. :159.504 Max. :44.198gg<- ggplot(data=COMP, aes(Year)) +
geom_line(aes(y = S.P.Composite, colour = "S.P.Composite")) +
geom_line(aes(y = Dividend, colour = "Dividend")) +
geom_line(aes(y = Earnings, colour = "Earnings")) +
geom_line(aes(y = CPI, colour = "CPI")) +
geom_line(aes(y = Long.Interest.Rate, colour = "Long.Interest.Rate")) +
geom_line(aes(y = Real.Price, colour = "Real.Price")) +
geom_line(aes(y = Real.Dividend, colour = "Real.Dividend")) +
geom_line(aes(y = Real.Earnings, colour = "Real.Earnings")) +
geom_line(aes(y = Cyclically.Adjusted.PE.Ratio, colour = "Cyclically.Adjusted.PE.Ratio"))
ggplotly(gg)5.5 Ceny bitcoina - BITCOIN
Dane zawierające cenę bitcoina były zbierane od 2009 roku do 2021 z częstotliwością 1 dnia. Można zauważyć, że do dnia 2010-08-15 wartość bitcoina według wczytanych danych była równa 0. Podejrzewam, że jest to przybliżenie jego wartości wynikające z niskiej ceny w tamtym okresie lub brakiem jego mierzalnej wartości. W maju 2010 roku pewien programista zakupił 2 pizze warte około 30 dolarów za 10 000 bitcoinów, czyli bitcoin przed tamtym okresem przyjmował wartości poniżej 0,003$ za 1 bitcoina. Było to też pierwsze wykorzystanie bitcoina w celach konsumpcyjnych. Dodatkowo bitcoin został wprowadzony na giełdę w lutym 2010 roku i początkowo giełdy te nie zdobyły popularności, co także mogło mieć wpływ na te wartości.
summary(MKPRU)## Date Value
## Length:4661 Min. : 0.0
## Class :character 1st Qu.: 7.2
## Mode :character Median : 431.9
## Mean : 5141.2
## 3rd Qu.: 6499.1
## Max. :63554.4MKPRU$Date <- as.Date(MKPRU$Date,format="%Y-%m-%d")
gg <- ggplot(data=MKPRU, aes(x=Date,y=Value)) + geom_line()
ggplotly(gg)6 Korelacja między zmiennymi
6.1 Cena złota a index giełdowy S&P
GOLDSP <- GOLD %>% mutate(Month = format(Date, format="%Y-%m"))
COMPSP <- COMP %>% mutate(Month = format(Year, format="%Y-%m"))
GOLDSP <- COMPSP %>% full_join(GOLDSP, by = "Month")
COR_GOLDSP <- GOLDSP %>% select(-c("Year", "Date", "Month")) %>% cor(use="pairwise.complete.obs")
corrplot(COR_GOLDSP, order = 'alphabet', number.cex=0.67, tl.cex = 0.67, addCoef.col = 'black', col = colorRampPalette(c('#E5D10A',"white","#BDE50A"))(200))
\52 z zbadanych atrybutów na 90 (bez wliczania korelacji między tymi
samymi atrybutami) posiada korelacje powyżej 0.8 z czego 21 atrybutów
powyżej 0.9. Zbiór atrybutów jest mocno skorelowany. W przypadku
korelacji atrybutów z ceną złota można zauważyć, że najwiekszą korelacją
cechują się atrybuty:
0.88 - Divident
0,86 - Earnings
0.83 - CPI
0.83 - Real.Divident
6.2 Cena złota a światowy wskaźnik rozwoju
GOLDINDI <- GOLD%>%
mutate(Year = format(Date, "%Y")) %>%
group_by(Year) %>%
summarise(avgGOLD= mean(USD)) %>%
transform(Year = as.numeric(Year))
INGOLD <- INDI %>% select(c("Series Name","Year","Value")) %>% mutate(Year = format(Year, format="%Y")) %>%
transform(Year = as.numeric(Year))
INGOLD <- INGOLD %>% inner_join(GOLDINDI,by="Year")
INGOLD <- INGOLD %>% select(-c("Year"))
COR_BITCOMP <- INGOLD %>% group_by(INGOLD$Series.Name) %>%
summarise(cor = cor(Value, avgGOLD))
COR_BITCOMP_minus <- COR_BITCOMP %>% filter(COR_BITCOMP$cor < -0.9)
COR_BITCOMP_plus <- COR_BITCOMP %>% filter(COR_BITCOMP$cor > 0.9)Część światowych wskaźników rozwoju w mocnym stopniu korelują z cenami złota (korelacja powyżej 0.90 lub korelacja poniżej -0.90). Dla korelacji dodatniej jest 19 takich wskaźników a dla ujemnej 11.
datatable(COR_BITCOMP_minus)datatable(COR_BITCOMP_plus)6.3 Cena złota a cena bitcoina
Współczynnik korelacji ceny złota od ceny bitcoina dla całego zbioru wyniósł 0.4981413 dlatego pomiędzy tymi dwiema zmiennymi możemy mówić o korelacji przeciętnej bądź średniej.
GOLDBIT <- merge(x = GOLD, y = MKPRU, by = "Date", all = TRUE)
GOLDBIT <- GOLDBIT %>%
drop_na()
GOLDBIT$USD <- as.numeric(GOLDBIT$USD)
GOLDBIT$Value <- as.numeric(GOLDBIT$Value)
M <- cor(GOLDBIT$USD, GOLDBIT$Value, method=c("pearson", "kendall", "spearman"))
M## [1] 0.4981413Na wykresie można zauważyć, że dynamika wzrostu ceny od roku 2017 jest dużo wyższa dla bitcoina niż złota. Cena złota w latach 2009-2021 była dużo stabilniejsza niż cena bitcoina, który cechował się dużą zmiennością, stąd też wynika średnia korelacja tych atrybutów.
ggplot(data=GOLDBIT, aes(Date)) +
geom_line(aes(y = USD, colour = "Cena złota")) +
geom_line(aes(y = Value, colour = "Cena bitcoina")) +
transition_reveal(Date)+
scale_colour_manual(values = c("blue", "red")) +
theme(legend.position = c(0.8, 0.9)) +
ggtitle("Bitcoin i złoto") 
6.4 Cena bitcoina a index giełdowy S&P
BITSP <- MKPRU %>% mutate(Month = format(Date, format="%Y-%m"))
BITCOMP <- COMP %>% mutate(Month = format(Year, format="%Y-%m"))
BITSP <- BITSP %>% full_join(BITCOMP, by = "Month")
COR_BITSP <- BITSP %>% select(-c("Year", "Date", "Month")) %>% cor(use="pairwise.complete.obs")
corrplot(COR_BITSP, order = 'alphabet', number.cex=0.67, tl.cex = 0.67, addCoef.col = 'black', col = colorRampPalette(c('#E5D10A',"white","#BDE50A"))(200))
przypadku korelacji atrybutów S&P między ceną bitcoina. Można
zauważyć mniejszą korelacje niż pomiędzy złotem a atrybutami S&P.
Najwiekszą korelacje pomiędzy Value Bitcoina a atrybutami S&P mamy
dla atrybutów:
0.78 - S.P.Composite
0.76 - Real.Price
0.70 - Cyclically.Adjusted.PE.Ratio
6.5 Cena bitcoina a światowy wskaźnik rozwoju
BITINDI <- MKPRU%>%
mutate(Year = format(Date, "%Y")) %>%
group_by(Year) %>%
summarise(avgBIT= mean(Value)) %>%
transform(Year = as.numeric(Year))
summary(BITINDI)## Year avgBIT
## Min. :2009 Min. : 0.00
## 1st Qu.:2012 1st Qu.: 8.47
## Median :2015 Median : 525.60
## Mean :2015 Mean : 5855.95
## 3rd Qu.:2018 3rd Qu.: 7362.71
## Max. :2021 Max. :44591.33BITCOMP <- INDI %>% select(c("Series Name","Year","Value")) %>% mutate(Year = format(Year, format="%Y")) %>%
transform(Year = as.numeric(Year))
BITCOMP <- BITCOMP %>% inner_join(BITINDI,by="Year")
BITCOMP <- BITCOMP %>% select(-c("Year"))
COR_BITCOMP <- BITCOMP %>% group_by(BITCOMP$Series.Name) %>%
summarise(cor = cor(Value, avgBIT))
COR_BITCOMP_minus <- COR_BITCOMP %>% filter(COR_BITCOMP$cor < -0.9)
COR_BITCOMP_plus <- COR_BITCOMP %>% filter(COR_BITCOMP$cor > 0.9)Można zauważyć, że światowych wskaźników rozwoju w mocnym stopniu skorelowanych z cenami bitcoina jest znacząco mniej (korelacja powyżej 0.90 lub korelacja poniżej -0.90). Dla korelacji złota było ich 30 a dla bitcoina jest ich łącznie 17.
datatable(COR_BITCOMP_minus)datatable(COR_BITCOMP_plus)7 Regresor przewidujący ceny złota
Ceny złota były bardziej skorelowane z badanymi zbiorami danych oraz
zbiór danych cen złota był dużo większy niż zbiór danych bitcoina który
wartości niezerowe przyjmował dopiero od 2010. Dlatego regresor zostanie
zbudowany do przewidywania cen złota. Ceny złota będą przewidywane na
podstawie poniższych danych:
S&P:
- Divident
- Earnings
- CPI
- Real.Divident
Światowy wskaźnik rozwoju: -GDP (current US dollar) -Total greenhouse
gas emissions (kt of CO2 equivalent)
Wskaźniki S&P zostały wybrane na podstawie poziomu korelacji, natomiast wskaźniki światowego rozwoju wytypowane zostały spośród 30 uzyskanych. Wskaźniki te są mocno związane z produkcją dóbr, powstawaniem miast na świecie i emisją gazów cieplarnianych związanych najczęściej z rozwojem przemysłu co może wpływać na prognozy cen złota. ## Wstępne przetworzenie danych
pre_COMP <- COMP %>% select("Year","Dividend","Earnings","CPI","Real.Dividend")
pre_COMP <- pre_COMP %>% mutate(Month = format(Year, format="%Y-%m"))INDI_GDP <- INDI %>% filter(`Series Name` == "GDP (current US dollar)")
INDI_GDP <- rename(INDI_GDP, GDP=Value)
INDI_GDP <- INDI_GDP %>% select(c("Year", "GDP", )) %>%
transform(Year = as.numeric(Year))
ggplot(INDI_GDP, aes(Year,GDP, group = 1)) +
geom_line() +
ggtitle("GPD")
INDI_Total <- INDI %>% filter(`Series Name` == "Total greenhouse gas emissions (kt of CO2 equivalent)")
INDI_Total <- rename(INDI_Total, GAS=Value)
INDI_Total <- INDI_Total %>% select(c("Year", "GAS")) %>%
transform(Year = as.numeric(Year))
ggplot(INDI_Total, aes(Year,GAS, group = 1)) +
geom_line() +
ggtitle("GAS")
pre_GOLD <- GOLD %>% mutate(Month = format(Date, format="%Y-%m")) %>% group_by(Month) %>% summarise(avgGOLD= mean(USD))
pre_COMP <- pre_COMP %>% mutate(Month = format(Year, format="%Y-%m"))
GOLD_COMB <- pre_GOLD %>% full_join(pre_COMP, by = "Month")
GOLD_COMB <- rename(GOLD_COMB, Date=Year)
GOLD_COMB <- GOLD_COMB %>% mutate(Year = format(Date, format="%Y")) %>% transform(Year = as.numeric(Year))
ALL_COMB <- GOLD_COMB %>% inner_join(INDI_Total, by = "Year")
ALL_COMB <- GOLD_COMB %>% inner_join(INDI_GDP, by = "Year")
summary(ALL_COMB)## Month avgGOLD Date Dividend
## Length:612 Min. : 34.95 Min. :1970-01-31 Min. : 3.070
## Class :character 1st Qu.: 292.01 1st Qu.:1982-10-23 1st Qu.: 6.855
## Mode :character Median : 384.96 Median :1995-07-15 Median :13.400
## Mean : 578.14 Mean :1995-07-16 Mean :17.799
## 3rd Qu.: 821.19 3rd Qu.:2008-04-07 3rd Qu.:23.885
## Max. :1971.17 Max. :2020-12-31 Max. :59.680
## Earnings CPI Real.Dividend Year
## Min. : 5.13 Min. : 37.80 Min. :18.02 Min. :1970
## 1st Qu.: 14.59 1st Qu.: 97.78 1st Qu.:20.24 1st Qu.:1982
## Median : 25.17 Median :152.50 Median :24.20 Median :1995
## Mean : 41.52 Mean :149.72 Mean :28.33 Mean :1995
## 3rd Qu.: 66.63 3rd Qu.:211.28 3rd Qu.:30.88 3rd Qu.:2008
## Max. :139.47 Max. :260.47 Max. :63.51 Max. :2020
## GDP
## Min. :2.987e+12
## 1st Qu.:1.170e+13
## Median :3.088e+13
## Mean :3.559e+13
## 3rd Qu.:6.044e+13
## Max. :8.761e+13Po przetworzeniu i połączeniu wszystkich atrybutów powstał zbiór zawierający 612 rekordów i nie posiadający żadnych wartości pustych.
ALL_COMB <- ALL_COMB %>% select(-c("Month","Date","Year"))7.1 Tworzenie modelu
Zbiór trenujący i testowy podzielono w proporcjach 75:25. A następnie wytrenowano model regresyjny randomForest.
smp_size <- floor(0.75 * nrow(ALL_COMB))
train_ind <- sample(seq_len(nrow(ALL_COMB)), size = smp_size)
trainset <- ALL_COMB[ train_ind,]
testset <- ALL_COMB
predictors <- trainset %>% select(-avgGOLD) %>% as.matrix()
output <- trainset$avgGOLD
model <- randomForest(x = predictors, y = output,
ntree = 50) # number of trees
model##
## Call:
## randomForest(x = predictors, y = output, ntree = 50)
## Type of random forest: regression
## Number of trees: 50
## No. of variables tried at each split: 1
##
## Mean of squared residuals: 2049.054
## % Var explained: 99.09rmse(predict(model, testset), testset$avgGOLD)## [1] 27.654937.2 Dostosowywanie modelu z wykorzystaniem careta
model_tuned <- train(avgGOLD ~ .,
method = "rf",
data = trainset,
ntree = 5)
model_tuned## Random Forest
##
## 459 samples
## 5 predictor
##
## No pre-processing
## Resampling: Bootstrapped (25 reps)
## Summary of sample sizes: 459, 459, 459, 459, 459, 459, ...
## Resampling results across tuning parameters:
##
## mtry RMSE Rsquared MAE
## 2 47.56395 0.9895347 26.55323
## 3 46.46304 0.9900294 25.97942
## 5 46.51963 0.9902986 26.39653
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 3.ggplot(model_tuned)
W przypadku tuned_model wyniki są minimalnie lepsze od zwykłego modelu.
rmse(predict(model, testset), testset$avgGOLD)## [1] 27.65493mae(predict(model, testset), testset$avgGOLD)## [1] 15.18075rmse(predict(model_tuned$finalModel, testset), testset$avgGOLD)## [1] 26.35187mae(predict(model_tuned$finalModel, testset), testset$avgGOLD)## [1] 13.192147.3 Analiza miary oceny
Do oceny przedstawionego modelu regresji zostały użyte 2 miary
oceny:
- RSME - pierwiastek błędu średniokwadratowego. Przedstawia on różnicę
między estymatorem a warością estymowaną. W przypadku lepszego modelu
przyjął on wartość 26.35187. Jest to dobry wynik gdyż ceny złota
przyjmowały wartości od 34.95 aż do 1971.17.
- MAE - jest to średni błąd bezwzględny wyniósł on 13.19214.
7.4 Analiza ważności atrybutów
Można zauważyć, że dla zwykłego modelu najważniejszym atrybutem było CPI z zbioru danych S&P natomiast dla modelu_tuned GPD z zbioru danych dotyczących światowych wskaźników rozwoju. Najmniejszy wpływ na uczenie modelu zwyłego miał Dividend, a dla tuned_model Earnings. Były to 2 atrybuty mocno skorelowane ze sobą.
par(mfrow = c(1,2))
varImpPlot(model, n.var = 5)
varImpPlot(model_tuned$finalModel, n.var = 5)